perm filename INNER.SAI[SYS,HE]10 blob
sn#080528 filedate 1974-01-08 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00017 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00003 00002 ENTRY FINSCN
00009 00003 DEFINE DEBOUT(A)="IF TYP_EDGE THEN OUTSTR(A&CRLF)",
00013 00004 ⊃ GIVEN LINE (X1,Y1) , (X2,Y2) TRUNCATE TO FIT
00016 00005 ⊃ COMPACT command - compacts LPS data structure
00019 00006 ⊃ check for intersection of line and
00021 00007 ⊃ main call for compacting
00025 00008 ⊃ adaptive interior scanner
00035 00009 ⊃ body of adaptive scanner
00037 00010 ⊃ new corners found, scan around them
00038 00011 ⊃ fine scan finished - coarse scan if not done yet
00041 00012 NON-ADAPTIVE INTERIOR EDGE SCANNER
00044 00013 ⊃ CONTINUE INITIALIZATION AND SETUP
00046 00014 ⊃ FINISH SETUP
00047 00015 ⊃ MAIN SCAN OF OBJECT
00049 00016 ⊃ PROCESS RESULTS OF SCAN
00051 00017 ⊃ SETUP FOR NEXT OBJECT
00056 ENDMK
⊗;
ENTRY FINSCN;
BEGIN "INNER"
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
REQUIRE "SQRT[SYS,HE]" LOAD_MODULE;
EXTERNAL PROCEDURE SCANINIT;
EXTERNAL PROCEDURE CWHEEL(INTEGER C);
EXTERNAL PROCEDURE FORG.;
EXTERNAL BOOLEAN PROCEDURE GIFTIE(INTEGER P, F; REFERENCE BOOLEAN E);
EXTERNAL INTEGER PROCEDURE GETCOR(INTEGER SIZE);
EXTERNAL PROCEDURE RELCOR(INTEGER PNTR);
EXTERNAL BOOLEAN PROCEDURE GSTATZ(INTEGER MASK, PNTR; REFERENCE BOOLEAN ERR);
EXTERNAL BOOLEAN PROCEDURE GSETST(INTEGER MASK, PNTR; REFERENCE BOOLEAN ERR);
EXTERNAL PROCEDURE GRSETS(INTEGER MASK,PNTR; REFERENCE BOOLEAN ERR);
EXTERNAL BOOLEAN PROCEDURE EDGE_KKP(REFERENCE ITEMVAR A;REFERENCE INTEGER S);
EXTERNAL INTEGER PROCEDURE GCREBL(INTEGER TYPE; REFERENCE BOOLEAN ERR);
EXTERNAL PROCEDURE GSTORD(INTEGER VAL,PNTR,CNT;REFERENCE BOOLEAN ERR);
EXTERNAL PROCEDURE GLINKR(INTEGER PNTRA,FLDA,PNTR,FLD;REFERENCE BOOLEAN ERR);
EXTERNAL PROCEDURE GCRERI(INTEGER PNTRA,FLDA,PNTR,FLD;REFERENCE BOOLEAN ERR);
EXTERNAL PROCEDURE GULINK(INTEGER PNTR,FLD;REFERENCE BOOLEAN FLAG);
FORTRAN PROCEDURE DATGET;
FORTRAN PROCEDURE DATPUT;
EXTERNAL PROCEDURE OUTOBJ(REFERENCE INTEGER STATUS);
EXTERNAL PROCEDURE SEENLINK(INTEGER ARG,BOX);
EXTERNAL REAL PROCEDURE SQRT(REAL X);
EXTERNAL PROCEDURE FADCHG(REAL X,Y;PROCEDURE FOO);
EXTERNAL PROCEDURE FRDCHG(REAL X,Y;PROCEDURE FOO);
EXTERNAL PROCEDURE CLIPCHG(INTEGER CLIP);
EXTERNAL PROCEDURE TVIN;
EXTERNAL PROCEDURE EJINIT(INTEGER CIR);
EXTERNAL INTEGER PROCEDURE GETOBJ(REFERENCE ITEMVAR ARG; BOOLEAN FLG;
REFERENCE BOOLEAN PROCEDURE XEQ);
EXTERNAL PROCEDURE DISREL(INTEGER PNTR);
EXTERNAL PROCEDURE CURVE(REFERENCE ITEMVAR ARG; REFERENCE INTEGER S);
EXTERNAL BOOLEAN PROCEDURE GETFIL(INTEGER A);
EXTERNAL BOOLEAN PROCEDURE OPSCAN(REFERENCE ITEMVAR ARG;
REFERENCE INTEGER S, E; INTEGER T, B, L, R);
DEFINE DEBOUT(A)="IF TYP_EDGE THEN OUTSTR(A&CRLF)",
CRLF="'15&'12", SAFEX="SAFE",
GET(I)="FOOLX(GGETD(PNTR,I,FLAG))", DSK="5", ⊃="COMMENT",
OUTLIN="2",CORRNG="1", DISFRM="2", PNTNUM="1", OBJNUM="3",OBJPNT="1",
CORPNT="1", SEGPNT="1", OBJRNG="1", LIMIT="4", CAMERA="8";
SAFEX REAL ARRAY ITEMVAR OUTXY, INXY;
INTERNAL BOOLEAN DEBUGX;
BOOLEAN FLAG, DO_COL;
SHORT INTEGER SIZE, BOXINC;
EXTERNAL SHORT INTEGER XSTRT, YSTRT, TVWORD, TMAX, BMAX, RSMAX, LSMAX, TOPLST,
OBJLST, TEMPNT, LSIDE, RSIDE, FLINE, LLINE, SAITEM, CORLST,DEBFRM,
CLDIFF, TVCAM;
EXTERNAL REAL SIDLEN, CIRCLE;
EXTERNAL BOOLEAN ST, SLIM,SCAN_ACC;
SAFEX SHORT INTEGER ARRAY BOXTAB[1:20];
comment variables:
CIRCLE is the radius of the Manfred operators
DO_COL is TRUE if filters to be changed during inside scaning;
SIMPLE BOOLEAN PROCEDURE DUMMY(INTEGER A; ITEMVAR B); RETURN(FALSE);
⊃ GIVEN LINE (X1,Y1) , (X2,Y2) TRUNCATE TO FIT
ENTIRELY IN TV'S FIELD OF VIEW.
RETURN FALSE IF ENTIRE LINE OUTSIDE;
BOOLEAN PROCEDURE INTEST(REFERENCE REAL X1,Y1,X2,Y2);
BEGIN REAL A,B,C;
SHORT INTEGER IND;
SAFEX REAL ARRAY COORDS[1:2,1:2];
SIMPLE BOOLEAN PROCEDURE SETUP(REAL VAL,OTH,F1,F2;INTEGER I1,I2);
BEGIN
IF F1≤VAL≤F2∨F2≤VAL≤F1 THEN
BEGIN
COORDS[IND←IND+1,I1] ← VAL;
COORDS[IND,I2] ← OTH;
IF IND=2 THEN RETURN(TRUE);
END;
RETURN(FALSE);
END;
IF 0.0<X1<333.0∧0.0<X2<333.0∧0.0<Y1<256.0∧0.0<Y2<256.0 THEN
RETURN(TRUE);
A ← Y2-Y1;
B ← X1-X2;
C ← X2*Y1-X1*Y2;
IND ← 0;
IF (A≠0)∧(((Y1≤0.0≤Y2∨Y2≤0.0≤Y1)∧SETUP(C/A,0.0,X1,X2,1,2))∨
((Y1≤256.0≤Y2∨Y2≤256.0≤Y1)∧
SETUP((C-256.0*B)/A,256.0,X1,X2,1,2)))∨
(B≠0)∧(((X1≤0.0≤X2∨X2≤0.0≤X1)∧SETUP(C/B,0.0,Y1,Y2,2,1))∨
((X1≤333.0≤X2∨X2≤333.0≤X1)∧
SETUP((C-333.0*A)/B,333.0,Y1,Y2,2,1))) THEN;
IF ¬IND THEN RETURN(FALSE);
IF ¬(0.0<X1<333.0)∨¬(0.0<Y1<256.0) THEN
BEGIN
X1 ← COORDS[IND,1];
Y1 ← COORDS[IND,2];
IND ← IND-1;
END;
IF ¬(0.0<X2<333.0)∨¬(0.0<Y2<256.0) THEN
BEGIN
IF ¬IND THEN RETURN(FALSE);
X2 ← COORDS[IND,1];
Y2 ← COORDS[IND,2];
END;
RETURN(TRUE);
END;
⊃ COMPACT command - compacts LPS data structure
uses EDGES⊗ARG≡foo or BOUNDARY⊗ARG≡foo as available
-2 no outline
-1 no object
0 ok - used EDGES association
1 ok - used BOUNDARY association
;
⊃ fill boxtab with box numbers in grid which contain a point
less than EPSILON from the line Ax+By+C=0 given endpoints
(X1,Y1) and (X2,Y2);
SIMPLE PROCEDURE GET_BOX(REAL X1, Y1, X2, Y2);
BEGIN SHORT INTEGER INCR, BOX, TBOX;
REAL HROW, ROW, COL, T1, A, B, C, D, START, DT, XX1, XX2;
LABEL L1, L2, L3, L4, L5, FINI;
DEFINE LEN="32.0", HLEN="LEN/2.0", EPSILON="4",HEPS="HLEN+EPSILON",
WID="11.314", COORD(X)="(X DIV LEN)*LEN+HLEN";
⊃ LEN, HLEN, AND HEPS ARE FUNCTIONS OF THE GRID SIZE SET IN SEEN.FAI,
WID←SQRT(2*HLEN↑2);
BOXINC ← 0;
XX1 ← X1;
XX2 ← X2;
IF XX1>XX2 THEN XX1↔XX2;
IF Y1>Y2 THEN BEGIN X1↔X2; Y1↔Y2; END;
IF (ROW←COORD(Y1)-LEN)<0 THEN ROW ← HLEN;
HROW ← COORD(Y2);
COL ← COORD(X1);
A ← Y2-Y1; ⊃ compute line equation;
B ← X1-X2;
C ← X2*Y1-X1*Y2;
D ← SQRT(A↑2+B↑2);
L1: INCR ← 0; ⊃ loop for each row of grid;
START ← COL;
TBOX ← BOX ← (ROW DIV LEN)*(333 DIV LEN)+COL DIV LEN;
L3: IF XX1≥COL+HEPS∨XX2≤COL-HEPS∨Y1≥ROW+HEPS∨Y2≤ROW-HEPS THEN GO TO L2;
DT ← ABS((A*COL+B*ROW+C)/D); ⊃ loop for each box in row;
IF DT-EPSILON>WID THEN GO TO L2; ⊃ center COL,ROW too far from line;
IF DT-EPSILON≤HLEN THEN GO TO L4; ⊃ line inside box;
⊃ check for intersection of line and
top or bottom of box +- EPSILON;
IF ABS(A)<0.00005 THEN
IF ROW-HEPS≤Y1≤ROW+HEPS THEN GO TO L4 ELSE GO TO L2;
T1 ← (-B*(ROW-HEPS)-C)/A;
IF COL-HEPS≤T1≤COL+HEPS∧XX1-HEPS≤T1≤XX2+HEPS THEN GO TO L4;
T1 ← (-B*(ROW+HEPS)-C)/A;
IF COL-HEPS≤T1≤COL+HEPS∧XX1-HEPS≤T1≤XX2+HEPS THEN GO TO L4;
⊃ Not inside box. If INCR=0 or 1 then done with row, else go right;
L2: IF INCR=-1 THEN BEGIN INCR←1; COL ← START; BOX←TBOX; GO TO L5; END;
ROW ← ROW+LEN;
IF ROW<HROW THEN COL←COORD("(-B*ROW-C)/A") ELSE
IF ROW-LEN=HROW∨ROW=HROW THEN COL←COORD(X2) ELSE GO TO FINI;
GO TO L1;
⊃ Box near line, store number and continue;
L4: BOXTAB[BOXINC←BOXINC+1] ← BOX;
IF ¬INCR THEN INCR ← -1;
L5: IF ¬(0<(COL←COL+INCR*LEN)<333) THEN GO TO L2;
BOX ← BOX+INCR;
GO TO L3;
⊃ Done, create a LINE block and fill it;
FINI: SAITEM ← GCREBL(CVSIX("LINE"),FLAG);
DATPUT(SAITEM,1,8,A,B,C,X1,Y1,X2,Y2,D);
IF GIFTIE(OBJLST,CORPNT,FLAG) THEN
GLINKR(CORLST,CORRNG,SAITEM,CORRNG,FLAG) ELSE
GCRERI(OBJLST,CORPNT,SAITEM,CORRNG,FLAG);
CORLST ← SAITEM;
END;
⊃ main call for compacting;
INTERNAL PROCEDURE COMP(REFERENCE ITEMVAR ARG; REFERENCE INTEGER STATUS);
BEGIN
SHORT INTEGER I, N, J;
REAL T, B, L, R, X, Y, XX, YY;
BOOLEAN SIMPLINES, FLAG;
SET FOO;
ITEMVAR OLDARG;
REAL PROCEDURE DOUT(INTEGER I,J);
RETURN(GLOBAL DATUM(OUTXY)[I,J]);
SIMPLE BOOLEAN PROCEDURE CTEST(REFERENCE INTEGER P;
REFERENCE ITEMVAR ARG);
RETURN(GSTATZ(16,P,FLAG));
T ← L ← 500.0;
R ← B ← 0;
OLDARG ← ARG;
IF ARG≠EVERY∧(TEMPNT←GETOBJ(ARG,FALSE,DUMMY))<0 THEN
BEGIN
OLDARG ← NIL;
TEMPNT ← GCREBL(CVSIX("OBJECT"),FLAG);
IF GIFTIE(TOPLST,OBJPNT,FLAG) THEN
GLINKR(OBJLST,OBJRNG,TEMPNT,OBJRNG,FLAG) ELSE
GCRERI(TOPLST,OBJPNT,TEMPNT,OBJRNG,FLAG);
OBJLST ← TEMPNT;
GSTORD(-1,OBJLST,DISFRM,FLAG);
GSTORD(CVN(ARG),OBJLST,OBJNUM,FLAG);
GSTORD(IF CVN(CURCAM[TVCAM])>0 THEN CVN(CURCAM[TVCAM])
ELSE CVN(NIL),OBJLST,CAMERA,FLAG);
GSETST(73,OBJLST,FLAG);
END ELSE BEGIN
IF (TEMPNT←GETOBJ(ARG,TRUE,CTEST))<0 THEN
BEGIN
STATUS ← -1;
ARG ← NIL;
RETURN END ELSE OBJLST ← TEMPNT;
IF OLDARG≠NIL THEN OLDARG ← ARG;
END;
FOO ← PHI;
SIMPLINES ← TRUE;
IF ¬(CVN(ITVAR_II)) THEN ITVAR_II ← NIL;
FOO ← GLOBAL EDGES⊗ITVAR_II;
IF LENGTH(FOO) THEN
BEGIN
OUTXY ← LOP(FOO);
N ← DOUT(1,0);
END ELSE BEGIN
FOO ← GLOBAL LINE⊗OLDARG;
N ← LENGTH(FOO);
END;
IF ¬LENGTH(FOO) THEN BEGIN STATUS←-2; ARG←NIL; RETURN; END;
IF OLDARG≠NIL THEN FORG.;
GULINK(OBJLST,CORPNT,FLAG);
GULINK(OBJLST,OUTLIN,FLAG);
FOR I←1 STEP 1 UNTIL N DO
BEGIN
IF SIMPLINES THEN
BEGIN
X ← DOUT(1,I);
Y ← DOUT(2,I);
XX ← DOUT(3,I);
YY ← DOUT(4,I);
END ELSE BEGIN SET EPTS;
EPTS ← GLOBAL ENDPT⊗LOP(FOO);
INXY ← LOP(EPTS);
OUTXY ← LOP(EPTS);
X ← GLOBAL DATUM(INXY)[1];
Y ← GLOBAL DATUM(INXY)[2];
XX ← GLOBAL DATUM(OUTXY)[1];
YY ← GLOBAL DATUM(OUTXY)[2];
END;
IF X<L THEN L←X;
IF X>R THEN R←X;
IF Y<T THEN T←Y;
IF Y>B THEN B←Y;
IF INTEST(X,Y,XX,YY) THEN
BEGIN
GET_BOX(X,Y,XX,YY);
IF ¬BOXINC THEN
BEGIN DEBOUT("""GET_BOX SCREWED UP"""); END;
FOR J←1 STEP 1 UNTIL BOXINC DO
SEENLINK(CVN(ARG),BOXTAB[J]);
END;
END;
GSETST(16,OBJLST,FLAG);
DATPUT(OBJLST,LIMIT,4,T,B,L,R);
STATUS ← IF SIMPLINES THEN 0 ELSE 1;
IF ¬GIFTIE(OBJLST,CORRNG,FLAG) THEN GSETST(128,OBJLST,FLAG);
IF OLDARG≠NIL∧YES_DRV THEN DISREL(OBJLST);
END;
⊃ adaptive interior scanner
- requires curve fitter running;
PROCEDURE ADAPT(SET BLOBS);
BEGIN
SAFEX REAL ARRAY CORNERS[1:100,1:2];
LIST OBJS;
SHORT INTEGER OBJ, CORMAX, CORIND, I, J, K, M, CURSTAT, EINIT,
BM, TM, LM, RM, PTR, DEBF, T, B, L, R, DSAVE;
SAFEX INTEGER ARRAY DISPLD[1:50];
LABEL LOOP, NXTOBJ, NEWOBJ, FINISH,NXTXXX, JMPOUT;
SET FOO;
REAL TT, TB, TL, TR;
REAL ARRAY ITEMVAR Z;
ITEMVAR ARG, ARGX;
BOOLEAN BIGSCAN;
PRELOAD_WITH 2,0,3,1;
SAFEX OWN INTEGER ARRAY NEXTCOL[0:3];
SIMPLE PROCEDURE COLOR(INTEGER CHG);
BEGIN INTEGER I;
CWHEEL(COLFILT_ACC←CHG);
I←12000;
WHILE I>0 DO I←I-1;
END;
SIMPLE PROCEDURE ADD(REAL X,Y);
BEGIN SHORT INTEGER I;
FOR I←CORMAX STEP -1 UNTIL 1 DO
IF ABS(CORNERS[I,1]-X)<10.0∧ABS(CORNERS[I,2]-Y)<10.0
THEN RETURN;
IF (CORMAX←CORMAX+1)>100 THEN
USERERR(0,0,"CORMAX OVERFLOWED");
CORNERS[CORMAX,1] ← X;
CORNERS[CORMAX,2] ← Y;
END;
PROCEDURE SCN(SHORT INTEGER T,B,L,R);
BEGIN SHORT INTEGER J;
EINIT ← TRUE;
WHILE TRUE DO
BEGIN STRING INP;
IF EQU(INP←INCHSL(J),"CANCEL") THEN GO TO JMPOUT;
IF EQU(INP,"NEXT") THEN GO TO NXTOBJ;
IF OPSCAN(ARGX←NIL, J, EINIT, T, B, L, R) THEN DONE;
IF ARGX≠ARG∧¬LISTX(OBJS,ARGX,1) THEN
PUT ARGX IN OBJS AFTER ∞;
END;
PTR ← GETOBJ(ARG,FALSE,DUMMY);
END;
⊃ body of adaptive scanner;
IF ¬ST∧COLFILT_ACC≠3 THEN COLOR(3);
IF ST THEN BEGIN TM←TMAX; BM←BMAX; LM←LSMAX; RM←RSMAX; END ELSE
BEGIN TM←15; BM←250; LM←10; RM←325; END;
DEBF ← GETPOG;
OBJS← CVLIST(BLOBS);
OBJ ← 1;
⊃ loop for each object;
NEWOBJ: CORMAX ← CORIND ← 0;
BIGSCAN ← FALSE;
ARG ← OBJS[OBJ];
PTR ← GETOBJ(ARG,FALSE,DUMMY);
IF PTR≤0 THEN GO TO NXTOBJ;
⊃ through this loop until no new corners;
LOOP: GRSETS(8,PTR,J);
CURVE(ARG,CURSTAT←-1);
IF CURSTAT<0 THEN GO TO NXTOBJ;
⊃ corners exist - put in array;
FOO ← GLOBAL LINE⊗ARG;
WHILE LENGTH(FOO) DO
BEGIN SET P;
P ← GLOBAL ENDPT⊗LOP(FOO);
Z ← LOP(P);
ADD(GLOBAL DATUM(Z)[1],GLOBAL DATUM(Z)[2]);
Z ← LOP(P);
ADD(GLOBAL DATUM(Z)[1],GLOBAL DATUM(Z)[2]);
END;
FOO ← GLOBAL DANGLE⊗ARG;
IF LENGTH(FOO) THEN
BEGIN
Z ← LOP(FOO);
J ← ARRINFO(GLOBAL DATUM(Z),2);
FOR I←1 STEP 1 UNTIL J DO
BEGIN DEFINE !="GLOBAL DATUM (Z)";
ADD(![I,1],![I,2]);
ADD(![I,3],![I,4]);
END;
END;
IF CORIND=CORMAX THEN GO TO FINISH;
⊃ new corners found, scan around them;
FOR I←CORIND+1 STEP 1 UNTIL CORMAX DO
BEGIN "CORNER"
SHORT INTEGER X,Y;
X ← CORNERS[I,1]+.5;
Y ← CORNERS[I,2]+.5;
T ← (Y-15) MAX TM;
B ← (Y+15) MIN BM;
L ← (X-15) MAX LM;
R ← (X+15) MIN RM;
IF DEBUGX THEN
BEGIN
DSAVE ← DPYPARS;
DPYSET(DISPLD);
FADCHG(L,T,AIVECT);
FRDCHG(R,T,RVECT);
FRDCHG(R,B,RVECT);
FRDCHG(L,B,RVECT);
FRDCHG(L,T,RVECT);
DPYOUT(DEBF);
DPYRESET(DSAVE);
END;
SCN(T,B,L,R);
END "CORNER";
CORIND ← CORMAX;
IF GSTATZ(8,PTR,J) THEN GO TO LOOP;
⊃ fine scan finished - coarse scan if not done yet;
FINISH: IF BIGSCAN THEN GO TO NXTXXX;
DATGET(PTR,LIMIT,4,TT,TB,TL,TR);
T ← TM MAX (TT-15);
B ← BM MIN (TB-15);
L ← LM MAX (TL-15);
R ← RM MIN (TR+15);
I ← CIRCLE;
M ← (B-T-2*I) DIV (((B-T-2*I) DIV 30) MAX 6);
IF M>4 THEN
BEGIN
IF DEBUGX THEN
BEGIN
DSAVE ← DPYPARS;
DPYSET(DISPLD);
FADCHG(L,T,AIVECT);
FRDCHG(R,T,RVECT);
FRDCHG(R,B,RVECT);
FRDCHG(L,B,RVECT);
FRDCHG(L,T,RVECT);
DPYOUT(DEBF);
DPYRESET(DSAVE);
END;
FOR J←B-I STEP -M UNTIL T+I DO SCN(J-I,J+I,L,R);
END;
T←TT; B←TB; L←TL; R←TR;
DATGET(PTR,LIMIT,4,TT,TB,TL,TR);
IF TT≥T-1∧TB≤B+1∧TL≥L-1∧TR≤R+1 THEN BIGSCAN ← TRUE;
IF GSTATZ(8,PTR,J) THEN GO TO LOOP;
NXTXXX: GSETST(32,PTR,J);
NXTOBJ: GRSETS(8,PTR,J);
IF (OBJ←OBJ+1)≤LENGTH(OBJS) THEN GO TO NEWOBJ;
IF DO_COL THEN
BEGIN "FILCHG"
OBJ←1;
IF ST THEN IF NEXTCOL[COLFILT_ACC]≠3∧
GETFIL(NEXTCOL[COLFILT_ACC]+2) THEN GO TO NEWOBJ
ELSE BEGIN
COLOR(NEXTCOL[COLFILT_ACC]);
IF FIL_ACC[COLFILT_ACC] THEN
AUTO_ACC←FIL_ACC[COLFILT_ACC] ELSE
BEGIN
CHANGE_ACC←TRUE;
SCANINIT;
FIL_ACC[COLFILT_ACC]←AUTO_ACC;
END;
END;
IF COLFILT_ACC≠3 THEN GO TO NEWOBJ;
END "FILCHG";
JMPOUT: RELPOG(DEBF);
END;
COMMENT NON-ADAPTIVE INTERIOR EDGE SCANNER
- CURVE FITTER NOT NEEDED;
INTERNAL PROCEDURE FINSCN(SET BLOBS; REFERENCE INTEGER STATUS);
BEGIN LABEL L1, LOOP, INOUT, L3, L2,L4,L5;
SAFEX ITEMVAR ARRAY OBJS[1:30];
SAFEX SHORT INTEGER ARRAY LIM[1:30,0:4];
SHORT INTEGER OCNT, I, INCR, TS, LS, BS, RS, OBJ, SIZ, AREA, J, K,
A, T, B, R, L, HT, HB, HR, HL, TVW, LT, LB, LR, LL, XT, XB,
XR, XL, TA, BA, LA, RA, EOF, BRK, STT, SB, SR, SL, DEBF,
XSAVE, YSAVE, CLSAV;
BOOLEAN EINIT, FLAG, LIMT, SCN, NEWBUF;
ITEMVAR ARG;
SIMPLE BOOLEAN PROCEDURE LIMS(SHORT INTEGER I);
BEGIN INTEGER PTR;
REAL TTA,TBA,TLA,TRA;
PTR ← GETOBJ(OBJS[I],FALSE,DUMMY);
IF PTR>0 THEN
BEGIN
DATGET(PTR,LIMIT,4,TTA,TBA,TLA,TRA);
TA←TTA;
BA←TBA;
LA←TLA;
RA←TRA;
END ELSE BEGIN
OBJS[I] ← NIL;
IF I=OCNT THEN OCNT ← OCNT-1;
END;
RETURN(PTR>0);
END;
XSAVE ← XSTRT;
YSAVE ← YSTRT;
CLSAV ← CLDIFF;
CLIPCHG(0);
SCN ← SCAN_ACC;
LIMT ← SLIM;
TVW ← TVWORD;
SLIM ← TRUE;
IF DEBUGX THEN DEBF ← GETPOG;
⊃ CONTINUE INITIALIZATION AND SETUP;
TS←TMAX;
BS←BMAX;
RS←RSMAX;
LS←LSMAX;
IF YES_CUR THEN BEGIN ADAPT(BLOBS); GO TO INOUT; END;
XT ← LT ← IF ST THEN TMAX ELSE 15;
XB ← LB ← IF ST THEN BMAX ELSE 250;
XR ← LR ← IF ST THEN RSMAX ELSE 300;
XL ← LL ← IF ST THEN LSMAX ELSE 10;
NEWBUF← SCAN_ACC ← FALSE;
INCR←CIRCLE;
SIZ ← SIZE;
L2: IF FLAG∨¬LENGTH(BLOBS) THEN
BEGIN
STATUS←0;
CLIPCHG(CLSAV);
RETURN;
END;
OBJS[OBJ←OCNT←1] ← LOP(BLOBS);
LIM[OBJ,0] ← TRUE;
IF ¬LIMS(OBJ) THEN GO TO L2;
FLINE←TMAX←(TA-10) MAX LT;
LLINE←BMAX←(BA+10) MIN LB;
RSIDE←RSMAX←(RA+10) MIN LR;
LSIDE←LSMAX←(LA-10) MAX LL;
WHILE LENGTH(BLOBS) DO
BEGIN
OBJS[OCNT ← OCNT+1] ← LOP(BLOBS);
IF LIMS(OCNT)∧(TA<TMAX∨BA>BMAX∨RA>RSMAX∨LA<LSMAX) THEN
BEGIN
LIM[OCNT,0] ← TRUE;
LIM[OCNT,1] ← (TA-10) MAX LT;
LIM[OCNT,2] ← (BA+10) MIN LB;
LIM[OCNT,3] ← (RA+10) MIN LR;
LIM[OCNT,4] ← (LA-10) MAX LL;
END;
END;
L1: I←((RSMAX-LSMAX+1)/9+2)*(BMAX-TMAX+1);
IF ¬ST∧I>SIZ THEN
BEGIN
IF NEWBUF THEN RELCOR(TVWORD);
NEWBUF←SIZ←I;
TVWORD ← GETCOR(SIZ);
END;
IF ¬ST THEN BEGIN TVIN; EJINIT(2);END;
⊃ FINISH SETUP;
IF DEBUGX THEN
BEGIN INTEGER DSAVE;
SAFEX INTEGER ARRAY DISPLD[1:50];
DSAVE ← DPYPARS;
DPYSET(DISPLD);
FADCHG(LSIDE,FLINE,AIVECT);
FRDCHG(LSIDE,LLINE,RVECT);
FRDCHG(RSIDE,LLINE,RVECT);
FRDCHG(RSIDE,FLINE,RVECT);
FRDCHG(LSIDE,FLINE,RVECT);
DPYOUT(DEBF);
DPYRESET(DSAVE);
END;
LOOP: EINIT ← TRUE;
IF ST THEN
BEGIN
XT↔FLINE;
XB↔LLINE;
XR↔RSIDE;
XL↔LSIDE;
STT←XT;
SB←XB;
SR←XR;
SL←XL;
END ELSE BEGIN
STT←FLINE;
SB←LLINE;
SR←RSIDE;
SL←LSIDE;
END;
⊃ MAIN SCAN OF OBJECT;
WHILE ¬OPSCAN(ARG←NIL,STATUS,EINIT,STT,SB,SL,SR) DO
BEGIN
IF ST THEN
BEGIN
XT↔FLINE;
XB↔LLINE;
XR↔RSIDE;
XL↔LSIDE;
END;
OBJS[OCNT+1]←ARG;
IF LIMS(OCNT+1)∧(TA<TMAX∨BA>BMAX∨RA>RSMAX∨LA<LSMAX) THEN
BEGIN
IF ARG≠OBJS[OBJ] THEN
BEGIN
FOR I←1 STEP 1 UNTIL OCNT DO
IF I≠OBJ∧ARG=OBJS[I] THEN DONE;
IF I>OCNT THEN
BEGIN
FOR I←1 STEP 1 UNTIL OCNT DO
IF OBJS[I]=NIL THEN DONE;
IF I>OCNT THEN OCNT ← I;
OBJS[I] ← ARG;
END;
LIM[I,0] ← TRUE;
LIM[I,1] ← (TA-10) MAX LT;
LIM[I,2] ← (BA+10) MIN LB;
LIM[I,3] ← (RA+10) MIN LR;
LIM[I,4] ← (LA-10) MAX LL;
END;
IF ¬ST THEN
BEGIN
FLINE ← STT;
LLINE←SB;
RSIDE←SR;
LSIDE←SL;
TVIN;
EJINIT(2);
END;
END;
IF ST THEN
BEGIN
XT↔FLINE;
XB↔LLINE;
XR↔RSIDE;
XL↔LSIDE;
END;
END;
⊃ PROCESS RESULTS OF SCAN;
IF ST THEN
BEGIN
XT↔FLINE;
XB↔LLINE;
XR↔RSIDE;
XL↔LSIDE;
END;
L5: IF LIMS(OBJ) THEN
BEGIN
T ← TMAX MIN TA;
B ← BMAX MAX BA;
R ← RSMAX MAX RA;
L ← LSMAX MIN LA;
IF T<TMAX∨B>BMAX∨R>RSMAX∨L<LSMAX THEN
BEGIN
FLINE←TMAX;
LLINE←BMAX;
RSIDE←RSMAX;
LSIDE←LSMAX;
IF T<TMAX THEN
BEGIN
LLINE←TMAX+10;
FLINE←TMAX←(T-10) MAX LT;
END ELSE
IF B>BMAX THEN
BEGIN
FLINE←BMAX-10;
LLINE←BMAX←(B+10) MIN LB;
END ELSE
IF L<LSMAX THEN
BEGIN
RSIDE←LSMAX+10;
LSIDE←LSMAX←(L-10) MAX LL;
END ELSE
IF R>RSMAX THEN
BEGIN
LSIDE←RSMAX-10;
RSIDE←RSMAX←(R+10) MIN LR;
END;
GO TO L1;
END;
END;
LIM[OBJ,1] ← TMAX;
LIM[OBJ,2] ← BMAX;
LIM[OBJ,3] ← RSMAX;
LIM[OBJ,4] ← LSMAX;
LIM[OBJ,0] ← FALSE;
IF (J ← GETOBJ(OBJS[OBJ],FALSE,DUMMY))>0 THEN GSETST(32,J,FLAG);
⊃ SETUP FOR NEXT OBJECT;
L3: FOR OBJ←1 STEP 1 UNTIL OCNT DO IF OBJS[OBJ]≠NIL∧LIM[OBJ,0] THEN DONE;
IF OBJ>OCNT THEN
INOUT: BEGIN
OUTOBJ(STATUS);
IF NEWBUF THEN BEGIN RELCOR(TVWORD);TVWORD←TVW;END;
SCAN_ACC ← SCN;
SLIM ← LIMT;
TMAX←TS;
BMAX←BS;
RSMAX←RS;
LSMAX←LS;
IF ST THEN
BEGIN
FLINE←TS;
LLINE←BS;
RSIDE ← RS;
LSIDE ←LS;
END;
STATUS ← 0;
IF DEBUGX THEN RELPOG(DEBF);
CLIPCHG(CLSAV);
XSTRT ← XSAVE;
YSTRT ← YSAVE;
RETURN;
END;
FLINE ← TMAX ← T ← LIM[OBJ,1];
LLINE ← BMAX ← B ← LIM[OBJ,2];
RSIDE ← RSMAX ← R ← LIM[OBJ,3];
LSIDE ← LSMAX ← L ← LIM[OBJ,4];
A ← (B-T)*(R-L);
J ← AREA ← -1;
FOR I←1 STEP 1 UNTIL OCNT DO IF I≠OBJ THEN
BEGIN
IF ¬LIMS(I) THEN GO TO L4;
TA←LIM[I,1];
BA←LIM[I,2];
RA←LIM[I,3];
LA←LIM[I,4];
HT ← IF TA≤T THEN T ELSE IF TA≥B THEN B ELSE TA;
HB ← IF BA≥B THEN B ELSE IF BA≤T THEN T ELSE BA;
HL ← IF LA≤L THEN L ELSE IF LA≥R THEN R ELSE LA;
HR ← IF RA≥R THEN R ELSE IF RA≤L THEN L ELSE RA;
K ← (HR-HL)*(HB-HT);
IF ¬K THEN GO TO L4;
IF K=A THEN BEGIN OBJS[OBJ] ← NIL; GO TO L3; END;
IF K>AREA THEN BEGIN AREA←K; J ← I; END;
L4: END;
IF J>0 THEN
BEGIN
TA←LIM[J,1];
BA←LIM[J,2];
RA←LIM[J,3];
LA←LIM[J,4];
TMAX ← IF TA≤T THEN T ELSE IF TA≥B THEN B ELSE TA;
BMAX ← IF BA≥B THEN B ELSE IF BA≤T THEN T ELSE BA;
LSMAX ← IF LA≤L THEN L ELSE IF LA≥R THEN R ELSE LA;
RSMAX ← IF RA≥R THEN R ELSE IF RA≤L THEN L ELSE RA;
GO TO L5;
END;
GO TO L1;
END;
END "INNER";